perm filename MPRFAI.FAI[RST,LCS] blob sn#236482 filedate 1976-09-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE MPRFAI
C00018 ENDMK
C⊗;
	TITLE MPRFAI
	ENTRY MPRFAI
	EXTERNAL DL,FRMT,.COMM.,XRN,ALF,STF,POSI,PTR,DPY,FONT,PLTR,CIRCLE
	EXTERNAL PLOT,ALPHA,NOTWRT,METER,SLUR,NOTWRT,ROFF,RHORZ,RESET
	EXTERNAL ITMSUB,GETFI2,FASTI2,BMSTF,PSRT,TOOMCH,ENDIT,STAFF
	EXTERNAL KSIG,MAKNUM,CLEFS,UNKNWN,ILLEGL,CENTX,RUNTHR,PLTCMD
;	IMPLICIT INTEGER(A-Q,S-Z)
;	REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
;	COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
;					   ↓↓↓↓↓ V IS FOR READIN ONLY
;	COMMON  /XRN/RN(3000),V(1000) /ALF/INP(72),ML
;	1 /STF/RSTFAC(-3/4),RSTJ2  /POSI/STFF(-3/4),JJ2,POS
;	1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
;	1/PLTR/PLT,RHT,DIS
;	EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
;	1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
;	1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
;	DATA IP/'P'/,FA1/'( A1)'/
MPRFAI:	0
	SETZM ITMS#		;	ITMS=0
	SETZM TOTAL 		;	TOTAL=0
	MOVN [999.0]		;	RPLT=-999.
	MOVEM RPLT#		;  RPLT WILL BE FOR HEAVY STAFF LINES.
;;MP23:	JSA 16,RESET		;23	TYPE 21
;;	K#			;21	FORMAT(' RESET BOTTOM? '$)
;;	MOVE K			;	ACCEPT FA1,K
;;	CAMN [ASCII/A    /]		;	IF(K.EQ.'A')GO TO 124
;;	JRST MP124		;	IF(K.EQ.'P')GO TO 123
		  ;TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
;;	CAMN [ASCII/P    /]
;;	JRST MP123
;;	JRST MP24		;	GO TO 24
;;MP123:	SETOM FONT		;123	JFONT=-1
;;	JRST MP23		;GO TO 23
;;MP124:	SETZM FONT		;124	JFONT=0
;;	JRST MP23		;	GO TO 23
;;MP24:	CAMN [ASCII/N    /]	;24	IF(K.EQ.'N')GO TO 22
;;	JRST MP22	; 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
  			; STARTING PEN POS.
			; 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
;;	MOVN [999.0]	;	TOP2=-999
;;	MOVEM TOP2
;;	SETZM RNOMOV#	;	RNOMOV=0
MP22:	SETZM ALF	;22	I1=0
		;RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
MP2:	MOVE [999.0]		;2	TOP=-999
	MOVNM DPY+1
	MOVEM DPY+2		;	BOT=999
MP20:	SETZM PLTR		;20	PLT=0
	SETZM PLOTIT#		;	PLOTIT=0
	SETOM EDX#		;	EDX=-1
	MOVEI 1			;	M=1
	MOVEM PTR+=253
	JRST MP5504		;	GO TO 5504


MP11:	JSA 16,NOTWRT		;11	CALL NOTWRT
MP57:	SKIPGE PLTR		;57	IF(PLT)GO TO 6120
	JRST MP6120
	AOS PTR+=250		;	ITEM=ITEM+1
	SKIPGE EDX		;	IF(EDX.EQ.-1)GO TO 77
	JRST MP77
	MOVE PTR+=253		; M	IF(M.LT.I)GO TO 6120
	CAMGE PTR+=252		; I
	JRST MP6120
MP77:	MOVN PLOTIT		;77	IF(PLOTIT.EQ.-2)GO TO 2311
	CAIN 2
	JRST MP2311
MP5504:	MOVE [ASCII/P    /]	;5504	IF(I1.EQ.IP)GO TO 2311
	CAMN ALF
	JRST MP2311
	MOVEM ALF		;	I1=IP
	MOVE [ASCII/X    /]	;	INP(2)='X'
	MOVEM ALF+1
MP311:	SETZM .COMM.+1		;311	JA=0
MP2311:	SETZM NOSET
	JSA 16,PLTCMD		;2311	CALL PLTCMD(NOSET)
	JUMP NOSET#
	MOVN ALF+1		;	IF(INP(2).EQ.-1)GO TO 30
	CAIN 1
	JRST MP30		; **** END OF DATA ***
	SKIPN PLOTIT		;	IF(PLOTIT.EQ.0)GO TO 3005
	JRST MP3005
	MOVE [ASCII/P    /]	;	I1=IP
	MOVEM ALF
	SETOM PLOTIT		;	PLOTIT=-1

       	MOVEI 1			;6531	M=1
	MOVEM PTR+=253
	SETOM EDX		;	EDX=-1
	SETZ 2,			;	DO 5532 K=1,9
MP5532:	KIFIX .COMM.+4(2)	;5532	JQ(K)=RJQ(K)
	MOVEM .COMM.+=24(2)
	CAIE 2,=8
	AOJA 2,MP5532
	MOVNI 1			;	IF(PLOTIT.EQ.-1)GO TO 5121
	CAMN PLOTIT
	JRST MP5121
MP590:	SETZM ALF		;590	I1=0
				; TO RUN THROUGH DATA.
	MOVE [999.0]		;	TOP=-999
	MOVNM DPY+1
	MOVEM DPY+2		;	BOT=999
				;GOES TO PLOTTER
MP85:	MOVEI 1			;85	M=1
	MOVEM PTR+=253	
	SETZM PTR+=250		;	ITEM=0
	MOVEM PLTR		;8852	PLT=1
	SETZM EDX		;	EDX=0
	JRST MP6120		;	GO TO 6120

MP30:	MOVE TOTAL		;30	A=TOTAL/200.0
	FDVR [200.0]		;	TYPE 300,A,ITMS
	MOVEM K#		;	CALL PLOT(0,0,99)
	JSA 16,ENDIT		;  THE END OF THE DATA
	JUMP K			;300	FORMAT(F7.2,' INCHES',I,' ITEMS')
	JUMP ITMS#

MP60:	KIFIX 2,.COMM.		;60	J2=R2
	MOVEM 2,.COMM.+3
	CAIL 2,5			;	IF(J2.LT.5)GO TO 16
	JRST MP160
	     			;IF(J2.GT.-4)GO TO 16
	CAMLE 2,[-4]		;	TYPE 160,J2
	JRST MP16
MP160:	JSA 16,ILLEGL		;	GO TO 57
	JUMP .COMM.+3		;160	FORMAT(' ILLEGAL STAFF# ',I4)
	JRST MP57
MP16:	MOVE STF+3(2)		;16	RSTJ2=RSTFAC(J2)
	MOVEM STF+10
	MOVE POSI+3(2)
	MOVEM POSI+11		;	5541	POS=STFF(J2)
	MOVE .COMM.+1		;	IF(JA.NE.16)GO TO 61
	CAIE =16
	JRST MP61
	MOVE .COMM.+6		;	IF(R5.GE.100)R5=R5-100
	CAMGE [100.0]	;>100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP PARTS  
	JRST .+3
	FSBR [100.0]
	MOVEM .COMM.+6		; R5
	MOVE .COMM.+=31		;	IF(J10.NE.1)GO TO 62
	CAIE 1
	JRST MP62
	MOVE RWD3		;	R3=RWD3
	MOVEM .COMM.+4		;C  POSITIONS TEXT ITEMS.
MP62:	MOVE .COMM.+6		;62	RWD3=R5*RSTJ2*R9+R3
	FMPR STF+10		;RSTJ2
	FMPR .COMM.+=10		;R9
	FADR .COMM.+4		;R3
	MOVEM RWD3
MP61:	MOVE .COMM.+4		;61	RX3=R3
	MOVEM .COMM.+=23
	JSA 16,RHORZ
	JUMP .COMM.+4		;	J3=ROFF(RHORZ(R3))
	JSA 16,ROFF		;C  LINE IS DIVIDED INTO 200 POINTS.
	JUMP 0
	KIFIX
	MOVEM .COMM.+=24	; J3
	JSA 16,CENTX		;	CALL CENTX
	FLTR .COMM.+=24	 ; SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
	MOVEM .COMM.+4		;	R3=J3
	MOVE 2,.COMM.+1		;	IF(JA.LE.2)GO TO 11
	CAIL 2,=19		;IF(JA.GT.18)CALL UNKNWN(JA)
	JRST MP5700
	JRST .@(2)
	MP11
	MP11
	MP68
	MP25
	MP67

	MP625		;JA=6
	MP116
	MP125
	MP11
	MP69		;JA=10
	
	MP68
	MP12
TOTAL:	0			;JA NEVER =13,14,15
RWD3:	0
TOP2:	0
	MP116
	MP81		;JA=17
;551	GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
	MP80
MP80:	JSA 16,METER		;	GO TO (116,81,80),JA-15
	JRST MP57	;C  FOR 16,17,18 (WORDS, KSIG, METER)
MP5700:	JSA 16,UNKNWN		;	TYPE 5700,JA
	JUMP .COMM.+1		;5700	FORMAT(' UNKNOWN CODE=',I3)
	JRST MP57		;	GO TO 57
			;TRAP FOR UNKNOWN CODE #S (SUCH AS 99-FOR "NO KSIG".

MP69:	JSA 16,MAKNUM		;69	CALL MAKNUM(R5)
	JUMP .COMM.+6		;	GO TO 57
	JRST MP57
MP68:	JSA 16,CLEFS		;68	CALL CLEFS
	JRST MP57		;	GO TO 57

MP67:	JSA 16,SLUR		;67	CALL SLUR
	JRST MP57		;	GO TO 57

MP116:	JSA 16,ALPHA		;116	CALL ALPHA
	JRST MP57		;	GO TO 57

MP81:	JSA 16,KSIG		;81	CALL KSIG
	JRST MP57		;	GO TO 57

MP12:	JSA 16,CIRCLE
	JRST MP57		;80	CALL METER
	         		;	GO TO 57
MP125:	SKIPE .COMM.		;125	IF(R2.EQ.0)RMOV=R8
	JRST .+3  
	MOVE .COMM.+=9
	MOVEM RMOV#
	JSA 16,STAFF
	JRST MP57
MP625:	JSA 16,BMSTF		;625	CALL BMSTF
				; BEAMS AND STAVES
	JRST MP57		;	GO TO 57

MP25:	JSA 16,ITMSUB		;25	CALL ITMSUB
			;  BAR LINES AND SEVERAL OTHER KINDS OF LINES.
	JRST MP57		;	GO TO 57

MP3005:	MOVN [999.0]		;3005	IF(RPLT.EQ.-999.)RPLT=R9
	CAME RPLT		;C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
	JRST .+3
	MOVE .COMM.+=10
	MOVEM RPLT
	MOVNI 2			;	PLOTIT=-2
	MOVEM PLOTIT
	SKIPN ITMS		;FIRST TIME CHECK FOR NOSET FLAG
	SKIPE NOSET		;NOSET=-1 IF NOSET IS ON
	JRST GETEM
  	MOVN [999.0]		;	TOP2=-999
  	MOVEM TOP2
  	SETZM RNOMOV#		;	RNOMOV=0
GETEM:	JSA 16,GETFI2		;	CALL GETFI2(NAME,-1)
	JUMP DL+2			;C  JUMP TO READ BIG FILES
	JUMP [-1]
	JSA 16,FASTI2		;	CALL FASTI2(RSTFAC,128)
	JUMP STF
	JUMP [=128]

	JSA 16,FASTI2		;	CALL FASTI2(PWDS,JJ2)
	JUMP  PTR
	JUMP POSI+10

;;	JSA 16,TTT
;;	POSI+10
;;	POSI+11

	JSA 16,FASTI2		;	CALL FASTI2(RN,IPOS)
	JUMP XRN
	JUMP POSI+11
	MOVE POSI+10		;	ITEM=JJ2-2
	SUBI 2
	MOVEM PTR+=250
	ADDM ITMS		;	ITMS=ITMS+ITEM
	MOVE POSI+11		;	I=IPOS
	MOVEM PTR+=252
	CAIG =2000		;2203	IF(I.LE.2000)GO TO 590
	JRST MP590
	JSA 16,TOOMCH		;	TYPE 4202,I
	JUMP POSI+11			;	STOP
			;4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
MP121:	SKIPN PLOTIT		;121	IF(PLOTIT.EQ.0)GO TO 5504
	JRST MP5504
MP5121:	JSA 16,PSRT  		;5121	CALL PLTSRT
	SETOM PLTR	;IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
	SKIPE RPLT		;	PLT=-1
	SOS PLTR		;	IF(RPLT.NE.0)PLT=-2
	        		;C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
	MOVE  2,.COMM.
	FMPR 2,[1.24]		;	DIS=R2*1.24
	MOVEM 2,PLTR+2
	MOVE .COMM.+4		;	RHT=R3*1.2
	FMPR [1.2]		;1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
	MOVEM PLTR+1
	FMPR DPY+2		;A=BOT*RHT
	MOVEM A#		;??????
	MOVNM DPY+2		;	BOT=-A
	SKIPN TOTAL		;	IF(TOTAL.EQ.0)TOTAL=BOT
	MOVNM TOTAL
	MOVE PLTR+1		;	TOTAL=TOTAL+TOP*RHT
	FMPR DPY+1
	FADRM TOTAL	     ;TOTAL includes BOT with first file only.
	MOVN [999.0]		;	IF(TOP2.EQ.-999)GO TO 8121
	CAMN TOP2
	JRST MP8121
	MOVE 2,TOP2		;	BOT=BOT+TOP2
	FADRM 2,DPY+2
	SKIPN TOP2		;	IF(TOP2.EQ.0)BOT=0
	SETZM DPY+2
	MOVE DPY+2
	MOVEM A			;	A=BOT
	JRST MP9121		;	GO TO 9121
MP8121:	SETZM RNOMOV		;8121	RNOMOV=0
MP9121:	SKIPE .COMM.+=8		;9121	IF(R7.EQ.0)R7=RMOV
	JRST .+3		;RMOV HAS INCHES FROM P8 OF STAFF 0.
	MOVE RMOV
	MOVEM .COMM.+=8
	MOVE RNOMOV		;	IF(RNOMOV.GT.1)BOT=RNOMOV
	CAMLE [1.0]
	MOVEM DPY+2
	MOVE [200.0]		;	RNOMOV=R6+R7*200.*R3
	FMPR .COMM.+4
	FMPR .COMM.+=8
	FADR .COMM.+7
	MOVEM RNOMOV#
	SETZM RMOV		;	RMOV=0
;  R6=1 FOR NO MOVE AT END.  R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
	SKIPE .COMM.+=26	;C (J4) P4=1 FOR XGP OUTPUT
	JRST MP6120		;	IF(J5.NE.0)GO TO 6120
	KIFIX DPY+2		;C  MOVES 0 POINT OVER EACH TIME.
	MOVEM K			;6121	CALL PLOT(0,IFIX(BOT),-3)
	JSA 16,PLOT		;C  MOVES PLOTTER UP IF P5=0.
	JUMP [0]
	JUMP K
	JUMP [-3]

MP6120:	MOVE PTR+=253		;C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
	CAML PTR+=252		;6120	IF(M.GE.I)GO TO 7120
	JRST MP7120		;	CALL RUNTHR(M)
	JSA 16,RUNTHR		;	GO TO 60
	JUMP PTR+=253
	JRST MP60
MP7120:	MOVEI 1			;7120	M=1
	MOVEM PTR+=253
	MOVE [50.0]		;71201 	A=50.*RHT
	FMPR PLTR+1
	MOVEM A
	MOVE PLTR+1		;	TOP=TOP*RHT
	FMPRM DPY+1
	SKIPN RNOMOV		;	IF(RNOMOV.EQ.0)GO TO 7122
	JRST MP7122
	SETZM A			;	A=0
MP7121:	MOVE RNOMOV		;7121	IF(RNOMOV.LE.1)GO TO 7123
	CAMG [1.0]
	JRST MP7123
	MOVEM A			;	A=RNOMOV
	FSBR DPY+1		;	TOTAL=TOTAL+A-TOP
	FADRM TOTAL
	JRST MP7123		;	GO TO 7123
MP7122:	MOVE A			;7122	TOTAL=TOTAL+A
	FADRM TOTAL
	FADR DPY+1		;	A=A+TOP
	MOVEM A
MP7123:	KIFIX A			;7123	CALL PLOT(0,IFIX(A),3)
	MOVEM K
	JSA 16,PLOT
	JUMP [0]
	JUMP K
	JUMP [3]
	MOVE RNOMOV		;	IF(RNOMOV.EQ.1)GO TO 20
	CAMN [1.0]		;C  PRESERVES TOP AND BOT IF RNOMOV
	JRST MP20
	MOVE A			;	TOP=A
	MOVEM DPY+1
	MOVEM TOP2		;	TOP2=TOP
	JRST MP2		;	GO TO 2
			;  TO MOVE 'PLOTTER' FOR XGP OUTPUT
			;  MOVES PLOTTER UP
		;  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.

	END